home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / FROMUTS / XLISP1 / !XLisp / c / XLINIT < prev    next >
Text File  |  1990-02-23  |  4KB  |  119 lines
  1. /* xlinit.c - xlisp initialization module */
  2. /*    Copyright (c) 1985, by David Michael Betz
  3.     All Rights Reserved
  4.     Permission is granted for unrestricted non-commercial use    */
  5.  
  6. #include "xlisp.h"
  7.  
  8. /* external variables */
  9. extern NODE *true,*s_dot;
  10. extern NODE *s_quote,*s_function,*s_bquote,*s_comma,*s_comat;
  11. extern NODE *s_lambda,*s_macro;
  12. extern NODE *s_stdin,*s_stdout;
  13. extern NODE *s_evalhook,*s_applyhook;
  14. extern NODE *s_tracenable,*s_tlimit,*s_breakenable;
  15. extern NODE *s_car,*s_cdr,*s_nth,*s_get,*s_svalue,*s_splist,*s_aref,*s_eql;
  16. extern NODE *s_rtable,*k_wspace,*k_const,*k_nmacro,*k_tmacro;
  17. extern NODE *k_test,*k_tnot,*k_optional,*k_rest,*k_aux;
  18. extern NODE *a_subr,*a_fsubr;
  19. extern NODE *a_list,*a_sym,*a_int,*a_float,*a_str,*a_obj,*a_fptr,*a_vect;
  20. extern struct fdef ftab[];
  21.  
  22. /* xlinit - xlisp initialization routine */
  23. xlinit()
  24. {
  25.     struct fdef *fptr;
  26.     NODE *sym;
  27.  
  28.     /* initialize xlisp (must be in this order) */
  29.     xlminit();    /* initialize xldmem.c */
  30.     xlsinit();    /* initialize xlsym.c */
  31.     xldinit();    /* initialize xldbug.c */
  32.     xloinit();    /* initialize xlobj.c */
  33.  
  34.     /* enter the builtin functions */
  35.     for (fptr = ftab; fptr->f_name; fptr++)
  36.     xlsubr(fptr->f_name,fptr->f_type,fptr->f_fcn);
  37.  
  38.     /* enter operating system specific functions */
  39.     osfinit();
  40.  
  41.     /* enter the 't' symbol */
  42.     true = xlsenter("T");
  43.     setvalue(true,true);
  44.  
  45.     /* enter some important symbols */
  46.     s_dot    = xlsenter(".");
  47.     s_quote    = xlsenter("QUOTE");
  48.     s_function    = xlsenter("FUNCTION");
  49.     s_bquote    = xlsenter("BACKQUOTE");
  50.     s_comma    = xlsenter("COMMA");
  51.     s_comat    = xlsenter("COMMA-AT");
  52.     s_lambda    = xlsenter("LAMBDA");
  53.     s_macro    = xlsenter("MACRO");
  54.     s_eql    = xlsenter("EQL");
  55.  
  56.     /* enter setf place specifiers */
  57.     s_car    = xlsenter("CAR");
  58.     s_cdr    = xlsenter("CDR");
  59.     s_nth    = xlsenter("NTH");
  60.     s_get    = xlsenter("GET");
  61.     s_svalue    = xlsenter("SYMBOL-VALUE");
  62.     s_splist    = xlsenter("SYMBOL-PLIST");
  63.     s_aref    = xlsenter("AREF");
  64.  
  65.     /* enter the readtable variable and keywords */
  66.     s_rtable    = xlsenter("*READTABLE*");
  67.     k_wspace    = xlsenter(":WHITE-SPACE");
  68.     k_const    = xlsenter(":CONSTITUENT");
  69.     k_nmacro    = xlsenter(":NMACRO");
  70.     k_tmacro    = xlsenter(":TMACRO");
  71.     xlrinit();
  72.  
  73.     /* enter parameter list keywords */
  74.     k_test    = xlsenter(":TEST");
  75.     k_tnot    = xlsenter(":TEST-NOT");
  76.  
  77.     /* enter lambda list keywords */
  78.     k_optional    = xlsenter("&OPTIONAL");
  79.     k_rest    = xlsenter("&REST");
  80.     k_aux    = xlsenter("&AUX");
  81.  
  82.     /* enter *standard-input* and *standard-output* */
  83.     s_stdin = xlsenter("*STANDARD-INPUT*");
  84.     setvalue(s_stdin,cvfile(stdin));
  85.     s_stdout = xlsenter("*STANDARD-OUTPUT*");
  86.     setvalue(s_stdout,cvfile(stdout));
  87.  
  88.     /* enter the eval and apply hook variables */
  89.     s_evalhook = xlsenter("*EVALHOOK*");
  90.     setvalue(s_evalhook,NIL);
  91.     s_applyhook = xlsenter("*APPLYHOOK*");
  92.     setvalue(s_applyhook,NIL);
  93.  
  94.     /* enter the error traceback and the error break enable flags */
  95.     s_tracenable = xlsenter("*TRACENABLE*");
  96.     setvalue(s_tracenable,NIL);
  97.     s_tlimit = xlsenter("*TRACELIMIT*");
  98.     setvalue(s_tlimit,NIL);
  99.     s_breakenable = xlsenter("*BREAKENABLE*");
  100.     setvalue(s_breakenable,true);
  101.  
  102.     /* enter a copyright notice into the oblist */
  103.     sym = xlsenter("**Copyright-1985-by-David-Betz**");
  104.     setvalue(sym,true);
  105.  
  106.     /* enter type names */
  107.     a_subr    = xlsenter(":SUBR");
  108.     a_fsubr    = xlsenter(":FSUBR");
  109.     a_list    = xlsenter(":CONS");
  110.     a_sym    = xlsenter(":SYMBOL");
  111.     a_int    = xlsenter(":FIXNUM");
  112.     a_float    = xlsenter(":FLONUM");
  113.     a_str    = xlsenter(":STRING");
  114.     a_obj    = xlsenter(":OBJECT");
  115.     a_fptr    = xlsenter(":FILE");
  116.     a_vect    = xlsenter(":ARRAY");
  117. }
  118.  
  119.